home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE21 / TCP / ReceiveMain.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-02-05  |  7.7 KB  |  250 lines
  1. unit ReceiveMain;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   ExtCtrls, OleCtrls, ISP, OLE2, StdCtrls, Menus;
  8.  
  9. type
  10.   TMainForm = class(TForm)
  11.     Image1: TImage;
  12.     TCP1: TTCP;
  13.     TCP2: TTCP;
  14.     MainMenu1: TMainMenu;
  15.     Connection1: TMenuItem;
  16.     connect1: TMenuItem;
  17.     Disconnect1: TMenuItem;
  18.     File1: TMenuItem;
  19.     Close1: TMenuItem;
  20.     procedure FormCreate(Sender: TObject);
  21.     procedure TCP1DataArrival(Sender: TObject; bytesTotal: Integer);
  22.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  23.     procedure TCP2ConnectionRequest(Sender: TObject; requestID: Integer);
  24.     procedure TCP1Error(Sender: TObject; Number: Smallint;
  25.       var Description: string; Scode: Integer; const Source,
  26.       HelpFile: string; HelpContext: Integer; var CancelDisplay: Wordbool);
  27.     procedure connect1Click(Sender: TObject);
  28.     procedure Disconnect1Click(Sender: TObject);
  29.     procedure Close1Click(Sender: TObject);
  30.   private
  31.     { Private declarations }
  32.   public
  33.     { Public declarations }
  34.   end;
  35.  
  36. var
  37.   MainForm: TMainForm;
  38.   Stream : TMemoryStream;  // This needs to be static
  39.  
  40.   
  41. implementation
  42. {$R *.DFM}
  43. uses Mmsystem, OneI;
  44. var
  45.   count : integer = 0;
  46.   pheader : PTFisherTCP = nil;
  47.   head : pbyte = nil;
  48.  
  49.  
  50. function IsClosed(Tcp1, Tcp2 : TTCP ): Boolean;
  51. var
  52.   i : integer;
  53. begin
  54.  {Should do something fancy like a thread that checks memory,
  55.   but this tends to work (as it should not be needed)}
  56.   for i := 1 to 1000 do
  57.     Application.ProcessMessages;
  58. end;
  59.  
  60. procedure UseData(Head : PByte; Count, DataType: Integer);
  61. {This is the function that is called after a complete data transaction
  62.  has occured.  It is pretty basic and should be easy to modify.  It takes
  63.  This function takes 3 basic parameter, a pointer, a size and a data type,
  64.  I demo a few ways to work with this data.}
  65. var
  66.   Stream: TMemoryStream;
  67.   FileStream: TFileStream;
  68.   StartUpInfo: TStartUpInfo;
  69.   ProcessInfo: TProcessInformation;
  70. begin
  71.  
  72.  case DataType of
  73.    OneI_BitMap : begin
  74.          Stream := TMemoryStream.Create;
  75.            try
  76.              Stream.Write(Head^, Count);
  77.              Stream.Seek(0,0);
  78.              with MainForm do begin
  79.                Image1.Picture.Bitmap.LoadFromStream(Stream);
  80.                {Becareful of small bitmaps!!! - you can hang
  81.                 But a little extra code could do the trick}
  82.                Width := Image1.Picture.Bitmap.Width;
  83.                Height := Image1.Picture.Bitmap.Height;
  84.              end;
  85.            finally
  86.               Stream.Free;
  87.            end;
  88.          end;
  89.    OneI_Wav : begin
  90.          if not PlaySound (pChar(head), 0, snd_memory) then
  91.            ShowMessage('Received a .wav that could not played')
  92.          end;
  93.    OneI_Exe:  begin
  94.          FileStream := TFileStream.Create('c:\sample.exe', fmCreate);
  95.            try
  96.              FileStream.write(head^, Count);
  97.            finally
  98.              FileStream.free;
  99.            end;
  100.              FillChar(StartUpInfo, SizeOf(TStartUpInfo), 0);
  101.              with StartUpInfo do begin
  102.                 cb := SizeOf(TStartUpInfo);
  103.                 wShowWindow := SW_ShowNormal;
  104.              end;
  105.              CreateProcess('c:\Sample.exe', Nil, Nil, Nil, False,
  106.                NORMAL_PRIORITY_CLASS, Nil, Nil, StartupInfo, ProcessInfo);
  107.  
  108.          {might want to delete the file now - might not...}
  109.        end;
  110.    else
  111.        ShowMessage('What is this Data?');
  112.     end; //case
  113. end;
  114.  
  115.  
  116. {TMain.TCP1DataArrival() is the real workhourse of the program.  DataArrival()
  117.  is called when incoming packets are received.  The programmer does
  118.  not know how many times it will called.}
  119. procedure TMainForm.TCP1DataArrival(Sender: TObject; bytesTotal: Integer);
  120. var
  121.   Window : pbyte;
  122.   Ptr: pointer;
  123.   databuffer : variant;
  124.   headerbuffer : variant;
  125.  begin
  126.  
  127. {Note Pheader will be nil the first time this method is called.  We rely
  128.  on this fact to know that the current infomation is a data header, not data.
  129.  So we know the size and layout of the data.  Becareful to keep this header
  130.  small so its tranmission does not take more than data transfer}
  131.    if pheader = nil then begin   // new data !!
  132.       {New header, get setup}
  133.       pheader := AllocMem(SizeOf(TFisherTCP));
  134.       HeaderBuffer := VarArrayCreate([0,SizeOf(TFisherTCP) -1], varbyte);
  135.       {grab the header record}
  136.       Tcp1.GetData(headerbuffer, (VT_Array or VT_ui1) , SizeOf(TFisherTCP) );
  137.       Try
  138.         {copy the data to my header variable}
  139.         ptr := VarArrayLock(headerbuffer);
  140.         move(Ptr^, pheader^, SizeOf(TFisherTCP));
  141.       Finally
  142.         VarArrayUnlock(HeaderBuffer);
  143.       end;
  144.       {finally allocate a buffer for the data, using a head pointer}
  145.       head := AllocMem(pheader^.size + 1 * sizeof(byte));
  146.       caption := 'Receiving';
  147.    end else begin  // pheader is not nil -> means we are grabing data!
  148.      { set up my data structures}
  149.       DataBuffer := VarArrayCreate([0,BytesTotal], varbyte);
  150.       {set my pointer}
  151.       window := head;
  152.       inc(window, count);
  153.       {grab a hunk of data from the port}
  154.       inc(count, Tcp1.BytesReceived);
  155.       Tcp1.GetData(DataBuffer, (VT_Array or VT_ui1 ) , BytesTotal);
  156.       {copy that hunk of data over}
  157.       try
  158.         ptr := VarArrayLock(DataBuffer);
  159.         move(Ptr^, window^, BytesTotal);
  160.       finally
  161.         VarArrayUnlock(DataBuffer);
  162.       end;
  163.  
  164. {At the end of each data transfer, check to see if this was the last
  165.  transfer...if so, use the data somehow}
  166.       if count  = pheader^.size then begin
  167.         UseData(head, count, pheader^.tag);
  168.         {Reset the data connection for the next transfer}
  169.         FreeMem(pheader);
  170.         pheader := nil;
  171.         count := 0;
  172.         FreeMem(head);
  173.         caption := 'Transfer Complete';
  174.       end //if-count
  175.     end;  //if-else..(pheader = nil)
  176. end;
  177.  
  178. {------ Form methods ------}
  179. procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
  180. begin
  181.   Tcp2.Close;
  182.   Tcp1.Close;
  183.   { Make sure both components are closed - A.V. if they are not.
  184.     The Tcp1.State may report connection are closed after a close -
  185.     but they may or not not be...}
  186.   while not IsClosed(Tcp1, tcp2) do
  187.     application.processMessages;
  188. end;
  189.  
  190. procedure TMainForm.FormCreate(Sender: TObject);
  191. begin
  192.   {Just make sure these controls are closed}
  193.   Tcp1.Close;
  194.   Tcp2.Close;
  195. end;
  196.  
  197. {------ TCP control events -----}
  198. procedure TMainForm.TCP2ConnectionRequest(Sender: TObject;
  199.   requestID: Integer);
  200. begin
  201.   {Note: these TCP controls can not issue an accept() to
  202.   themselves.  So there must be two controls}
  203.   Tcp1.Accept(requestId);
  204.   Tcp2.Close;
  205.   caption := 'Connected';
  206. end;
  207.  
  208. procedure TMainForm.TCP1Error(Sender: TObject; Number: Smallint;
  209.   var Description: string; Scode: Integer; const Source, HelpFile: string;
  210.   HelpContext: Integer; var CancelDisplay: Wordbool);
  211. begin
  212.   {This method does not do much, just closes the TCP controls and
  213.   displays the generic message}
  214.   Tcp1.close;
  215.   Tcp2.close;
  216.   Showmessage(description);
  217. end;
  218.  
  219. {---------------- Menu event methods --------------------}
  220. procedure TMainForm.connect1Click(Sender: TObject);
  221. begin
  222.   {Sets the application into listen mode}
  223.   connect1.caption := 'Listening';
  224.   connect1.enabled := False;
  225.   connect1.checked := True;
  226.   Tcp2.Listen;
  227.   Disconnect1.enabled := True;
  228.   caption := 'Listening';
  229. end;
  230.  
  231. procedure TMainForm.Disconnect1Click(Sender: TObject);
  232. begin
  233.   {disconnects or stops listening}
  234.   Tcp1.close;
  235.   Tcp2.close;
  236.   Connect1.caption := 'Listen';
  237.   Connect1.checked := False;
  238.   Disconnect1.enabled := False;
  239.   connect1.enabled := True;
  240.   caption := 'Not Connected'
  241. end;
  242.  
  243. procedure TMainForm.Close1Click(Sender: TObject);
  244. begin
  245.   {Close the application}
  246.   Close;
  247. end;
  248.  
  249. end.
  250.